perm filename CLEFXG.F4[NEW,LCS]2 blob
sn#291775 filedate 1977-07-04 generic text, type T, neo UTF8
00100 SUBROUTINE CLEFS
00200 DIMENSION KPNT1(11),JCLEF(2100),RCMIN(4),KPNT2(11),KCLEF(350)
00300 1,CM(4),LCLEF(350),KPNT3(11),MCLEF(350),NCLEF(350),ICLEF(350)
00400 1,KPNT4(11),KPNT5(11),KPNT6(11),KPNT7(11),JJCLEF(350)
00500 COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
00600 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI
00700 DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
00800 EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
00900 1 KPNT2(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
01000 1,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(KJ,KPNT1(11)),(KCLEF,JCLEF(351))
01100 1,(R3,RJQ(1)),(LCLEF,JCLEF(701)),(KL,KPNT3(11)),(KM,KPNT4(11))
01200 1,(MCLEF,JCLEF(1051)),(NCLEF,JCLEF(1401)),(KN,KPNT5(11))
01300 1,(KI,KPNT6(11)),(ICLEF,JCLEF(1751)),(KJJ,KPNT7(11))
01400 1,(JJCLEF,JCLEF(2101)),(J8,JQ(6))
01500 CX J5=MOD(J5,100)
01600 CX IF(J5)J5=-J5
01700 CALL NOZERO(R6)
01800 IF(R7.EQ.0)R7=R6
01900 C IF P7 = 0, IT WILL EQUAL P6.
02000 IF(JA.GT.10)GO TO 9
02100 NAME='CLEFA'
02200 IF(J5.LT.20)GO TO 4
02300 R6=R6*.3
02400 C SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
02500 R7=R7*.3
02600 GO TO 4
02700 9 IF(NAME.EQ.NJR)GO TO 4
02800 IF(NAME.EQ.0)GO TO 177
02900 IF(NJR.EQ.0)GO TO 4
03000 177 IF(NJR.EQ.0)GO TO 8
03100 C TO PICK UP BASIC DRAW NAME FROM P10
03200 NAME=NJR
03300 GO TO 4
03400 8 TYPE 5
03500 5 FORMAT(' SET P10=1'/)
03600 C LEADS TO PROPER FILE CALL
03700 4 NM=NAME+2*(J5/10)
03800 C DRAW0 HAS ITEMS 0→9; DRAW1, 10→19; ETC. TO DRAW9, 90→99
03900 JEZ=MOD(J5,10)+1
04000 2 IF(NM.EQ.NM1)GO TO 30
04100 IF(NM.EQ.NM2)GO TO 30
04200 IF(NM.EQ.NM3)GO TO 30
04300 IF(NM.EQ.NM4)GO TO 30
04400 IF(NM.EQ.NM5)GO TO 30
04500 IF(NM.EQ.NM6)GO TO 30
04600 IF(NM.EQ.NM7)GO TO 30
04700 C SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
04800 C JUMP IF ALREADY IN CORE
04900 NPP=0
05000 IF(JA.NE.11)GO TO 1111
05100 C DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
05200 NPP=-1
05300 IF(LOOKF(NM))GO TO 1111
05400 TYPE 1112,NM
05500 RETURN
05600 1112 FORMAT(1XA5,' -- NOT FOUND')
05700 KX=0
05800 1111 CALL GETFI2(NM,NPP)
05900 GO TO(33,233,333,433,533,633),KX
06000 C GOES TO 133 WHEN KX IS 0
06100 133 KX=1
06200 NM1=NM
06300 CALL FASTI2(KPNT1,11)
06400 CALL FASTI2(JCLEF,KJ)
06500 C NEW DATA READER 6/74 -- 5/75 HOLDS 3 .DMD FILES IF THEY FIT.
06600 IF(KJ.LE.350)GO TO 30
06700 KX=0
06800 NM2=0
06900 GO TO 30
07000 33 CALL FASTI2(KPNT2,11)
07100 IF(KK.GT.350)GO TO 1112
07200 C JUMP BACK IF IT WON'T FIT.
07300 CALL FASTI2(KCLEF,KK)
07400 NM2=NM
07500 KX=2
07600 GO TO 30
07700 233 CALL FASTI2(KPNT3,11)
07800 IF(KL.GT.350)GO TO 1112
07900 C JUMP BACK IF IT WON'T FIT.
08000 CALL FASTI2(LCLEF,KL)
08100 KX=3
08200 NM3=NM
08300 C CHECK THE ABOVE -- FOR P5 HEIGHT CHANGE *********************
08400 C R6 IS SIZE FACTOR
08500 GO TO 30
08600 333 CALL FASTI2(KPNT4,11)
08700 IF(KM.GT.350)GO TO 1112
08800 C JUMP BACK IF IT WON'T FIT.
08900 CALL FASTI2(MCLEF,KM)
09000 KX=4
09100 NM4=NM
09200 GO TO 30
09300 433 CALL FASTI2(KPNT5,11)
09400 IF(KN.GT.350)GO TO 1112
09500 C JUMP BACK IF IT WON'T FIT.
09600 CALL FASTI2(NCLEF,KN)
09700 KX=5
09800 NM5=NM
09900 GO TO 30
10000 533 CALL FASTI2(KPNT6,11)
10100 IF(KN.GT.350)GO TO 1112
10200 C JUMP BACK IF IT WON'T FIT.
10300 CALL FASTI2(ICLEF,KI)
10400 KX=6
10500 NM6=NM
10600 GO TO 30
10700 633 CALL FASTI2(KPNT7,11)
10800 IF(KN.GT.350)GO TO 1112
10900 C JUMP BACK IF IT WON'T FIT.
11000 CALL FASTI2(JJCLEF,KJJ)
11100 KX=0
11200 NM7=NM
11300 30 IF(J5.GT.3)GO TO 811
11400 IF(JA.NE.3)GO TO 811
11500 C 0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP) MINI→R4+100
11600 C ↑↑↑↑↑↑↑↑ FIXUP SOMEDAY IN .DMD FILES
11700 IF(IABS(J4).LT.80)GO TO 812
11800 RSTJ2=.8*RSTJ2
11900 C TO SET HGT. OF MINI CLEFS
12000 R4=R4+CM(JEZ)
12100 C SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
12200 812 IF(JEZ.NE.4)GO TO 811
12300 R4=R4+2
12400 JEZ=3
12500 C ABOVE IS NOW AT TOP
12600
12700 811 A=R4
12800 R4=A+2.9
12900 C ADJUSTS HEIGHT(??)
13000 CALL CENTX
13100 R4=A
13200
13300 L=KPNT1(JEZ)
13400 IF(NM.EQ.NM2)L=KPNT2(JEZ)+350
13500 IF(NM.EQ.NM3)L=KPNT3(JEZ)+700
13600 IF(NM.EQ.NM4)L=KPNT4(JEZ)+1050
13700 IF(NM.EQ.NM5)L=KPNT5(JEZ)+1400
13800 IF(NM.EQ.NM6)L=KPNT6(JEZ)+1750
13900 IF(NM.EQ.NM7)L=KPNT7(JEZ)+2100
14000 IF(L.LE.0)RETURN
14100 C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
14200 IF(J9.EQ.0)GO TG 31
14300 C***** ROTATE *******
14400 R7=R7*RSTJ2
14500 R6=R6*RSTJ2
14600 N=JCHEF(L)
14700 KNT=701
14800 C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
14900 JCLEF(KNT)=N
15000 DO 1 K=L+1,N+L-1
15100 CALL UNPACK(J,M,JCLEF(K))
15200 X=J*R6
15300 Y=M*R7
15400 JJ=JCLEF(K)/100000000
15500 AX=ATAN2(X,Y)*57.29578
15600 HYP=SQRT(X**2+Y**2)
15700 ROT=DEG+AX
15800 J=ROFF(HYP*COSD(ROT))
15900 M=ROFF(HYP*SIND(ROT))
16000 KNT=KNT+1
16100 IF(J)J=1000-J
16200 IF(M)M=1000-M
16300 1 JCLEF(KNT)=M*10000+J+JJ*100000000
16400 L=701
16500 C *********** SEE AT TOP **********
16600 R6=1.
16700 R7=1.
16800 RSTJ2=1.
16900 C SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
17000 CC CALL ROTATE(JCLEF,L)
17100 NM3=0
17200 C WIPES OUT DATA AREA FOR NM3
17300 C R9=P9=DEGREES OF ROTATION (0-360)
17400 IF(KK.GT.350)KX=0
17500 C CHECK TO SEE IF DATA WAS WIPED OUT.
17600 31 A=-1
17700 C FLAG FOR THICKNESS OR NO.
17800 IF(J8.EQ.-2)GO TO 32
17900 IF(R8.LE.0)GO TO 34
18000 A=0
18100 C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
18200 CALL THICK
18300 C SEE CLEFZ.F4 FOR "THICK" CODE (THICK IS IN MFAIL.FAI)
18400 GO TO 32
18500 CC34 IF(IPLT)GO TO 77
18600 CC31 IF(R8.EQ.-2)GO TO 32
18700 C R8=-2 OMITS FILLER DURING PLOT
18800 CCC IF(IPLT)GO TO 77
18900 34 IF(IPLT)77,77,32
19000 CCCC IF(R8.NE.-1)GO TO 32
19100 77 DO 3 K=L+1,JCLEF(L)+L
19200 IF(JCLEF(K).LT.200000000)GO TO 3
19300 JEZ=JCLEF(L)-1
19400 IF(K.GT.L+1)JEZ=JEZ-K+L+1
19500 CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
19600 GO TO 32
19700 3 CONTINUE
19800 C FILLS ONLY WHEN PLOTING OR R8=-1
19900 32 CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
20000 C 3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
20100 IF(A)RETURN
20200 IF(J8.NE.0)GO TO 234
20300 IF(J9.EQ.0)RETURN
20400 GO TO 134
20500 234 J8=J8-1
20600 R3=R3+XDIS
20700 C XDIS=1 PLOTTER STEP NO MATTER WHAT SIZE FACTOR USED
20800 134 IF(J9.EQ.0)GO TO 32
20900 J9=J9-1
21000 CENTR=CENTR+XDIS
21100 GO TO 32
21200
21300 END